home *** CD-ROM | disk | FTP | other *** search
/ Mac-Source 1994 July / Mac-Source_July_1994.iso / Other Langs / Tickle-4.0 (tcl) / tcl / src / tclMPWShell.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-11-08  |  4.3 KB  |  219 lines  |  [TEXT/MPS ]
  1. /* 
  2.  * tclTest.c --
  3.  *
  4.  *    Test driver for TCL.
  5.  *
  6.  * Copyright 1987-1991 Regents of the University of California
  7.  * All rights reserved.
  8.  *
  9.  * Permission to use, copy, modify, and distribute this
  10.  * software and its documentation for any purpose and without
  11.  * fee is hereby granted, provided that the above copyright
  12.  * notice appears in all copies.  The University of California
  13.  * makes no representations about the suitability of this
  14.  * software for any purpose.  It is provided "as is" without
  15.  * express or implied warranty.
  16.  */
  17.  
  18. #ifndef lint
  19. static char rcsid[] = "$Header: /user6/ouster/tcl/tclTest/RCS/tclTest.c,v 1.19 91/11/17 14:07:21 ouster Exp $ SPRITE (Berkeley)";
  20. #endif
  21.  
  22. #include <resources.h>
  23. #include <events.h>
  24. #include <files.h>
  25. #include <stdio.h>
  26. #include <stdlib.h>
  27. #include <errno.h>
  28. #include <string.h>
  29. #include <stdarg.h>
  30. #include "tcl.h"
  31. #include "tclExtend.h"
  32.  
  33. char dumpFile[100];
  34. int quitFlag = 0;
  35.  
  36. char *initCmd =
  37.     "if [file exists [info library]:init.tcl] {source [info library]:init.tcl}";
  38.  
  39. /*
  40.  * The following variable is a special hack that allows applications
  41.  * to be linked using the procedure "main" from the Tcl library.  The
  42.  * variable generates a reference to "main", which causes main to
  43.  * be brought in from the library (and all of Tcl with it).
  44.  */
  45.  
  46. extern int main();
  47. int *tclDummyMainPtr = (int *) main;
  48.  
  49.  
  50. Tcl_AppInit(interp)
  51.     Tcl_Interp    *interp;
  52.     {
  53.     short    app_refnum;
  54.     short    app_vrefnum;
  55.     Str32    volname;
  56.     
  57.     /* Get application's open resource fork reference number. */
  58.     app_refnum = CurResFile();
  59.     
  60.     /* Get working directory/volume reference number of application. */
  61.     GetVol(volname, &app_vrefnum);
  62.  
  63.     TclMac_CWDInitialize();
  64.     TclMac_InitializeOnce(app_refnum);
  65.  
  66.     Tcl_InitExtended(interp);
  67.     
  68.     Tcl_AddMacintoshCmds(interp);
  69.     Tcl_InitMacintosh(interp);
  70.  
  71.     if (Tcl_Init(interp) == TCL_ERROR) /* Sources init.tcl */
  72.         {
  73.         fprintf(stderr, "ERROR in Tcl_Init() --\n");
  74.         fprintf(stderr, "      %s\n",
  75.                     (interp->result==NULL ? "" : interp->result) );
  76.         }
  77.  
  78.     if (Tcl_ShellEnvInit( interp, TCLSH_INTERACTIVE ) != TCL_OK)
  79.         {
  80.         fprintf(stderr, "ERROR in Tcl_ShellEnvInit() --\n");
  81.         fprintf(stderr, "      %s\n",
  82.                     (interp->result==NULL ? "" : interp->result) );
  83.         }
  84.  
  85.     tcl_RcFileName = getenv("TCLSHRC");
  86.     if (tcl_RcFileName == NULL)
  87.            tcl_RcFileName = "tclshrc";
  88.     
  89.     return TCL_OK;
  90.     }
  91.  
  92. #ifdef NEVER_DEFINED
  93.     /* ARGSUSED */
  94. int
  95. cmdCheckmem(clientData, interp, argc, argv)
  96.     ClientData clientData;
  97.     Tcl_Interp *interp;
  98.     int argc;
  99.     char *argv[];
  100. {
  101.     if (argc != 2) {
  102.     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  103.         " fileName\"", (char *) NULL);
  104.     return TCL_ERROR;
  105.     }
  106.     strcpy(dumpFile, argv[1]);
  107.     quitFlag = 1;
  108.     return TCL_OK;
  109. }
  110.  
  111.     /* ARGSUSED */
  112. int
  113. cmdEcho(clientData, interp, argc, argv)
  114.     ClientData clientData;
  115.     Tcl_Interp *interp;
  116.     int argc;
  117.     char *argv[];
  118. {
  119.     int i;
  120.  
  121.     for (i = 1; ; i++) {
  122.     if (argv[i] == NULL) {
  123.         if (i != argc) {
  124.         echoError:
  125.         sprintf(interp->result,
  126.             "argument list wasn't properly NULL-terminated in \"%s\" command",
  127.             argv[0]);
  128.         }
  129.         break;
  130.     }
  131.     if (i >= argc) {
  132.         goto echoError;
  133.     }
  134.     fputs(argv[i], stdout);
  135.     if (i < (argc-1)) {
  136.         printf(" ");
  137.     }
  138.     }
  139.     printf("\n");
  140.     return TCL_OK;
  141. }
  142. #endif
  143.  
  144. void
  145. Feedback(char *format, ...)
  146.     {
  147.     va_list        varg;
  148.     
  149.     va_start(varg, format);
  150.     
  151.     vfprintf(stderr, format, varg);
  152.     
  153.     va_end(varg);
  154.  
  155.     fprintf(stderr, "\n");
  156.     }
  157.  
  158. int
  159. mac_printf( char *format_str, ... )
  160.     {
  161.     int            result;
  162.     va_list        varg;
  163.     
  164.     va_start(varg, format_str);
  165.     
  166.     result = vprintf(format_str, varg);
  167.     
  168.     va_end(varg);
  169.     
  170.     return result;
  171.     }
  172.  
  173. int
  174. mac_fprintf( FILE * fp, char *format_str, ... )
  175.     {
  176.     int            result;
  177.     va_list        varg;
  178.     
  179.     va_start(varg, format_str);
  180.     
  181.     result = vfprintf(fp, format_str, varg);
  182.     
  183.     va_end(varg);
  184.     
  185.     return result;
  186.     }
  187.  
  188. RotateCursor(phase)
  189.     long    phase;
  190.     {
  191.     extern pascal void ROTATECURSOR(int phase);
  192.     
  193.     ROTATECURSOR(phase);
  194.     }
  195.  
  196. /*
  197. ** This is called by tcl when an environment variable
  198. ** is set, giving you the change to keep your code
  199. ** variables in sync with the $env() tcl variables.
  200. **
  201. ** When the tcl code "set env(name) value" is executed
  202. ** this call is made as:
  203. **    "check_environment_set_of_globals(name, value)".
  204. */
  205. check_environment_set_of_globals(name, value)
  206.     char    *name;
  207.     char    *value;
  208.     {
  209. #pragma unused (name, value)
  210.     }
  211.  
  212. CheckCmdPeriod()
  213.     {
  214.     KeyMap    mykeys;
  215.  
  216.     GetKeys(mykeys);
  217.     return (mykeys[1] == 0x00808000);
  218.     }
  219.